      PROGRAM MONREP
C
      INTEGER CBT,CBTT,CODE,YEAR,THISYR,SCB 
      INTEGER BEG,END,T
C
      DIMENSION CBT(54),RLCONT(54),RTMON(54),AVECONT(54)
      DIMENSION T2(25),T3(25),T4(25),T5(25),T6(25),T8(25)
      DIMENSION BEG(23),END(23),STITLE(25,21),TITLE(55,28)
      DIMENSION TOT2(25),TOT5(25),TOT7(25),TOT3(25)
      DIMENSION TOT4(25),TOT6(25),TOT8(25),SCB(52) 
      DIMENSION TOT1(25),RLMON(54)
      DIMENSION OUT(54),PRE(54),AVPRE(54)
C
      CHARACTER*6 IDATA(12),IBLANK,LCONT(54),LMON(54),TMON(54),TT(52)
      CHARACTER*6 IAVECONT(54),IPRE(54),IAVPRE(54),IOUT(54)
      CHARACTER*8 IOT2(25),IOT4(25),IOT5(25),IOT7(25),IOT8(25)
      CHARACTER*7 IOT1(25),IOT3(25)
      CHARACTER*9 IOT6(25)
C
      DATA CBT/4HAGA ,4HAMF ,4HAND ,4HARK ,4HBNK ,4HBEU ,4HBUL ,4HBUM ,
     1         4HCSC ,4HCLE ,4HCLR ,4HCLS ,4HCCR ,4HCRA ,4HCRE ,4HDED ,
     2         4HEMI ,4HGCL ,4HFIS ,4HFOR ,4HGRS ,4HHAY ,4HSCO ,4HHPD ,
     3         4HHGH ,4HHYA ,4HISL ,4HJCK ,4HKAC ,4HKEE ,4HLOW ,4HCMO ,
     4         4HMIN ,4HWOD ,4HLUC ,4HMAN ,4HMCK ,4HOCH ,4HOWY ,4HPAL ,
     5         4HPHL ,4HPOT ,4HPRV ,4HRES ,4HRIM ,4HRIR ,4HCCL ,4HSOL ,
     6         4HTHF ,4HUNY ,4HWAR ,4HWAS ,4HWIC ,4HWLD /
      DATA SCB/4HPHL ,4HTHF ,4HAND ,4HARK ,4HLUC ,4HLOW ,4HBNK ,4HPOT ,
     1         4HOCH ,4HPRV ,4HCRA ,4HWIC ,4HHAY ,4HCRE ,4HSCO ,4HCMO ,
     2         4HRES ,4HSOL ,4HWOD ,4HMAN ,4HAMF ,4HGRS ,4HISL ,4HJCK ,
     4         4HPAL ,4HRIR ,4HMIN ,4HCCL ,4HCCR ,4HOWY ,4HCSC ,4HDED ,
     4         4HAGA ,4HEMI ,4HHPD ,4HHYA ,4HCLS ,4HMCK ,4HUNY ,4HBEU ,
     5         4HWAR ,4HBUL ,4HWAS ,4HWLD ,4HBUM ,4HCLE ,4HCLR ,4HKAC ,
     6         4HKEE ,4HRIM ,4HGCL ,4HHGH /
      DATA BEG/1,3,7,9,11,15,16,17,19,20,21,28,30,31,33,37,39,40,
     1         43,44,45,51,52/
      DATA END/2,6,8,10,14,15,16,18,19,20,27,29,30,32,36,38,39,42,43,
     2         44,50,51,52/
C
1000  FORMAT(A4,2I2,12A6)
C     
C     INITIALIZE ADDITION TOTALS FOR SUMARY REPORT
C
      IBLANK='      '
      DO 200 I=1,25
      TOT1(I)=0.
      TOT2(I)=0.
      TOT5(I)=0.
      TOT7(I)=0.
  200 CONTINUE
      CALL IDATE(MON,IDA,IYR)
      MOL=MON
	MOL=MOL-1
   	NYR=IYR
      IF(MON.EQ.1)THEN
                  NYR=NYR-1
                  MOL=12
                  END IF
C
	MON=MON-1
C     NEXT DETERMINE LAST YEAR THIS YEAR MONTHLY DATA LOCATION ON
C     REGDATA FILE
      IF(MON.GT.9)THEN
                  LASTYR=IYR
                  THISYR=IYR+1
                  LOCATE=MON-9
      END IF
      IF(MON.LE.9)THEN
                  LASTYR=IYR-1
                  THISYR=IYR
                  LOCATE=MON+3
      END IF
C
C     FIND CORRECT STATION ON REGDATA FILE
   40 READ(1,1000,END=100)CBTT,CODE,YEAR,(IDATA(I),I=1,12)
      DO 41 I=1,54
      IF(CBTT.EQ.CBT(I))GO TO 42
   41 CONTINUE
      GO TO 40
C
C     GO TO APPROPIATE DATA TYPE CALCULATION
   42 GO TO(101,201,301,40,40,40,70,80,40,40,40,40,40,40,40,40)CODE
      GO TO 40
 1001 FORMAT(F6.0)
C
C      LOCATING THIS YEAR AND LAST YEAR EOM CONTENT
  101 IF(YEAR.EQ.LASTYR) THEN
                 LINE=I
                 LCONT(LINE)=IDATA(LOCATE)
                 DECODE(6,1001,IDATA(LOCATE))RLCONT(LINE)
                 IF(MON.EQ.10)LMON(LINE)=IDATA(LOCATE+11)
      END IF
      IF(YEAR.EQ.THISYR) THEN
                 LL=LOCATE-1
                 IF(MON.EQ.10)GO TO 2000
                 LMON(LINE)=IDATA(LL)
2000             DECODE(6,1001,LMON(LINE))RLMON(LINE)
                 TMON(LINE)=IDATA(LOCATE)
                 DECODE(6,1001,IDATA(LOCATE))RTMON(LINE)
      END IF
      GO TO 400
C
C     LOCATING THE 1963-1977 AVERAGE EOM CONTENT
  201 IAVECONT(LINE)=IDATA(LOCATE)
      DECODE(6,1001,IDATA(LOCATE))AVECONT(LINE)
      GO TO 400
C
C     LOCATING THE OUTFLOW DATA ON REGDATA FILE
  301 IOUT(LINE)=IDATA(LOCATE)
      DECODE(6,1001,IDATA(LOCATE))OUT(LINE)
      GO TO 40
C
C     LOCATING THE PRECIPITATION DATA ON REGDATA FILE
   70 IPRE(LINE)=IDATA(LOCATE)
      DECODE(6,1001,IDATA(LOCATE))PRE(LINE)
      GO TO 40
C
C     LOCATING AVERAGE PRECIPITATION DATA ON REGDATA FILE
   80 IAVPRE(LINE)=IDATA(LOCATE)
      DECODE(6,1001,IDATA(LOCATE))AVPRE(LINE)
      GO TO 40
C
C
C     CALCULATING TOTAL RESERVOIR CONTENT,OUTFLOW,AVERAGE PRECIP,
C                 PRECIPITATION FOR MONTHLY REPORT
  100 DO 102 I=1,54
      IF(LMON(I).NE.IBLANK.AND.TMON(I).NE.IBLANK)THEN
                            TRLMON=TRLMON+RLMON(I)
                            TRTMON=TRTMON+RTMON(I)
                            TAVECO=TAVECO+AVECONT(I)
                            TOUT=TOUT+OUT(I)
      END IF
      IF(IPRE(I).NE.IBLANK.AND.IAVPRE(I).NE.IBLANK)THEN
                            TAVPRE=TAVPRE+AVPRE(I)
                            TPRE=TPRE+PRE(I)
      END IF
  102 CONTINUE
      GO TO 500
C
C      GROUPING LOGIC-- GROUPS RESERVOIRS INTO PROJECTS FOR SUMARY REPORT
  400 DO 401 IH=1,52
      IF(CBTT.EQ.SCB(IH)) GO TO 402
  401 CONTINUE
      GO TO 40
C
C     LOCATING WHICH PROJECT THE RESERVOIR BELONGS
  402 IF(IH.GT.0.AND.IH.LT.3)K=1
      IF(IH.GT.2.AND.IH.LT.7)K=2
      IF(IH.GT.6.AND.IH.LT.9)K=3
      IF(IH.GT.8.AND.IH.LT.11)K=4
      IF(IH.GT.10.AND.IH.LT.15)K=5
      IF(IH.EQ.15)K=6
      IF(IH.EQ.16)K=7
      IF(IH.GT.16.AND.IH.LT.19)K=8
      IF(IH.EQ.19)K=9
      IF(IH.EQ.20)K=10
      IF(IH.GT.20.AND.IH.LT.28)K=11
      IF(IH.GT.27.AND.IH.LT.30)K=12
      IF(IH.EQ.30)K=13
      IF(IH.GT.30.AND.IH.LT.33)K=14
      IF(IH.GT.32.AND.IH.LT.37)K=15
      IF(IH.GT.36.AND.IH.LT.39)K=16
      IF(IH.EQ.39)K=17
      IF(IH.GT.39.AND.IH.LT.43)K=18
      IF(IH.EQ.43)K=19
      IF(IH.EQ.44)K=20
      IF(IH.GT.44.AND.IH.LT.51)K=21
      IF(IH.EQ.51)K=23
      IF(IH.EQ.52)K=24
C 
C     GROUPING DATA CALCULATIONS
    1 IF(CODE.EQ.2)THEN
                   TOT7(K)=TOT7(K)+AVECONT(LINE)
      END IF
      IF(CODE.EQ.1)THEN
                   IF(YEAR.EQ.LASTYR)THEN
                     TOT5(K)=TOT5(K) +RLCONT(LINE)
                     END IF
                   IF(YEAR.EQ.THISYR)THEN
                     TOT2(K)=TOT2(K)+RTMON(LINE)
                     TT(IH)=TMON(LINE)
                     END IF
      END IF
      GO TO 40
C
C      LOADING RESERVOIR AND PROJECT NAME DATA 
  500 DO 403 K=1,55
      READ(2,1002)(TITLE(K,I),I=1,28)
  403 CONTINUE
 1002 FORMAT(28A1)
      DO 404 K=1,25
      READ(2,1003)(STITLE(K,I),I=1,21),TOT1(K)
 1003 FORMAT(21A1,F7.1)
  404 CONTINUE
      TOT1(22)=0.
      DO 405 I=1,21
      TOT1(22)=TOT1(22)+TOT1(I)
      TOT7(22)=TOT7(22)+TOT7(I)
      TOT5(22)=TOT5(22)+TOT5(I)
      TOT2(22)=TOT2(22)+TOT2(I)
  405 CONTINUE
C
C
      LF=0
      DO 412 K=1,21
      DO 411 I=BEG(K),END(K)
      IF(TT(I).EQ.IBLANK)LF=LF+1
  411 CONTINUE
      KC=END(K)-BEG(K)+1
      IF(LF.EQ.KC)THEN
                  TOT7(22)=TOT7(22)-TOT7(K)
                  TOT1(22)=TOT1(22)-TOT1(K)
                  T2(K)=-999999.
                  T4(K)=-999999.
                  T5(K)=-999999.
                  T6(K)=-999999.
                  T8(K)=-999999.
                  T3(K)=-999999.
      END IF
      LF=0
  412 CONTINUE
      TOT1(25)=0.
      DO 406 I=22,24
      TOT1(25)=TOT1(25)+TOT1(I)
      TOT7(25)=TOT7(25)+TOT7(I)
      TOT5(25)=TOT5(25)+TOT5(I)
      TOT2(25)=TOT2(25)+TOT2(I)
  406 CONTINUE
C
      DO 407 I=1,25
      IF(TOT1(I).EQ.0)THEN
                      TOT3(I)=0.
                      GO TO 417
      END IF
      TOT3(I)=TOT2(I)/TOT1(I)*100
  417 TOT4(I)=TOT1(I)-TOT2(I)
      TOT6(I)=TOT2(I)-TOT5(I)
      TOT8(I)=TOT2(I)-TOT7(I)
      ENCODE(7,1010,IOT1(I))TOT1(I)
      ENCODE(8,1011,IOT2(I))TOT2(I)
      ENCODE(7,1013,IOT3(I))TOT3(I)
      ENCODE(8,1011,IOT4(I))TOT4(I)
      ENCODE(8,1011,IOT5(I))TOT5(I)
      ENCODE(9,1012,IOT6(I))TOT6(I)
      ENCODE(8,1011,IOT7(I))TOT7(I)
      ENCODE(8,1011,IOT8(I))TOT8(I)
      IF(T2(I).EQ.-999999.)IOT2(I)='        '
      IF(T3(I).EQ.-999999.)IOT3(I)='       '
      IF(T4(I).EQ.-999999.)IOT4(I)='        '
      IF(T5(I).EQ.-999999.)IOT5(I)='        '
      IF(T6(I).EQ.-999999.)IOT6(I)='         '
      IF(T8(I).EQ.-999999.)IOT8(I)='        '
  407 CONTINUE
 1010 FORMAT(F7.1)
 1011 FORMAT(F8.1)
 1012 FORMAT(F9.1)
 1013 FORMAT(F7.0)
C
C      PRINT OUT MONTHLY REPORT
C**********************************************************************
C
      T=NYR
      M=MOL
      WRITE(3,1004)T,M,T,M,T,M,T,M,T,M
 1004 FORMAT(1H1,30X,'BUREAU OF RECLAMATION--PN REGION',/,33
     +X,'OUTLOOK FOR WATER-REPORT FOR   ',I2,'/',I2,/,42X,
     +'(1000 ACRE-FEET)',/,10X,80(1H-),/,10X,'   RESERVOIR           ACT  
     +IVE    BEGINING  END   AVERAGE OUTFLOW  PRECIPITATION',
     +/10X,'  OR STATION          CAPACITY     ',I2,'/',I2,3X,I2,'/',
     +I2,3X,'E.O.M.',2X,I2,'/',I2,4X,I2,'/',I2,4X,'AVG'/10X,80(1H-))
      DO 408 K=1,54
      WRITE(3,1005)(TITLE(K,I),I=1,28),LMON(K),TMON(K),IAVECONT(K),
     +             IOUT(K),IPRE(K),IAVPRE(K)
  408 CONTINUE
 1005 FORMAT(10X,28A1,5X,A6,5(2X,A6))
      WRITE(3,1006)(TITLE(55,I),I=1,28),TRLMON,TRTMON,TAVECO,
     +             TOUT,TPRE,TAVPRE
 1006 FORMAT(10X,80(1H-)/10X,28A1,F11.1,3F8.1,2F8.2)
C
C     PRINTOUT SUMMARY REPORT
	DO 1117 I=1,5
	WRITE(3,1118)
1118	FORMAT(' ')
1117	CONTINUE
      WRITE(3,1007)NYR,MOL
 1007 FORMAT(1H1,35X,'BUREAU OF RECLAMATION',/,
     +       30X,'SUMMARY OF E.O.M. ACTIVE STORAGE CONTENTS',/,
     +       43X,'(1000 ACRE--FEET)',/,48X,I2,'/',I2,/,10X,86(1H-)/,
     +      13X,'RESERVOIR          ACTIVE   E.O.M. PERCENT  SPACE    LA
     +ST    CHANGE AVERAGE  CHANGE',/,16X,'OR',13X,'CAPACITY CONTENTS FU
     +LL  AVAILABLE  YEAR     FROM  CONTENTS  FROM',/,14X,
     +'PROJECT',43X,'CONTENTS   LAST',10X,'AVERAGE',/,75X,'YEAR',/,
     +       10X,86(1H-))
      DO 409 K=1,21
      WRITE(3,1008)(STITLE(K,I),I=1,21),IOT1(K),IOT2(K),IOT3(K),
     +             IOT4(K),IOT5(K),IOT6(K),IOT7(K),IOT8(K)
  409 CONTINUE
 1008 FORMAT(10X,21A1,A7,A8,A7,2A8,A9,2A8)
      WRITE(3,1009)
 1009 FORMAT(10X,86(1H-))
      DO 410 K=22,24
      WRITE(3,1008)(STITLE(K,I),I=1,21),IOT1(K),IOT2(K),IOT3(K),
     +             IOT4(K),IOT5(K),IOT6(K),IOT7(K),IOT8(K)
  410 CONTINUE
      WRITE(3,1009)
      WRITE(3,1008)(STITLE(25,I),I=1,21),IOT1(25),IOT2(25),IOT3(25),
     +             IOT4(25),IOT5(25),IOT6(25),IOT7(25),IOT8(25)
      CALL EXIT
      END
